home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / stv.lha / STV / st_v / util / STVUTIL5.ZIP / PUBLIC.WIN < prev    next >
Text File  |  1993-02-07  |  11KB  |  305 lines
  1. "This Smalltalk/V Windows filein allows you to create a new 
  2. type of browser, called a Public Method Browser.  It is identical 
  3. in all respects to a standard Class Hierarchy Browser, except 
  4. that it shows only public methods.
  5.  
  6. A public method is generally distinguished by the inclusion 
  7. of the word 'Private' as the first word in the first comment in
  8. the method.  This code assumes that placement, but it is
  9. easily modified.  Note that doing so will significantly slow
  10. initialization.
  11.  
  12. The Public Method Browser uses a global variable, PublicMethods,
  13. which contains a dictionary of all public methods in your
  14. system.  It MUST be initialized before you can use the
  15. Public Method Browser.
  16.  
  17. To install, file in this file by selecting it and choosing FileIn
  18. from the Smalltalk menu.
  19.  
  20. You will be prompted for creation of the PublicMethods global.
  21. Respond 'Yes' to this prompt. 
  22.  
  23. To initialize the PublicMethods dictionary, evaluate the expression
  24.  
  25.     PublicBrowser initialize
  26.  
  27. This process takes a few minutes, since it needs to scan all of
  28. the source code currently in your system.
  29.  
  30. To open a Public Method Browser, evaluate the expression
  31.  
  32.     PublicBrowser new openOn: (Array with: Object)
  33.  
  34. or add the Public Method Browser to the File menu by modifying the 
  35. ApplicationWindow>>fileMenu method.  If you choose to do this,
  36. evaluate the expression
  37.  
  38.     Notifier reinitialize
  39.  
  40. so the Transcript menu will include this change.
  41.     
  42.     New Global Variable:        PublicMethods
  43.     New Class:                       PublicBrowser
  44.     New Instance Methods:    PublicBrowser>>label 
  45.                                               PublicBrowser>>selectors
  46.     New Class Methods:         PublicBrowser>>initialize
  47.                                               PublicBrowser>>initializeClassDictionary
  48.                                               PublicBrowser>>initializeInstanceDictionary
  49.     Modified Methods:            Behavior>>compile:notifying
  50.                                               Behavior>>removeSelector
  51.                                               ClassHierarchyBrowser>>addSubClass
  52.                                               ClassHierarchyBrowser>>removeSubClass"
  53.  
  54. ClassHierarchyBrowser subclass: #PublicBrowser
  55.   instanceVariableNames: ''
  56.   classVariableNames: ''
  57.   poolDictionaries: '' !
  58.  
  59. PublicMethods := Dictionary new!                         
  60.  
  61. !PublicBrowser class methods !
  62.  
  63. initialize
  64.     "Initialize the public class and instance dictionaries."
  65.  
  66.     Transcript nextPutAll: 'Initializing Public Dictionaries...';cr.
  67.     self
  68.         initializeClassDictionary;
  69.         initializeInstanceDictionary.
  70.     Transcript nextPutAll: 'Public dictionaries initialized.'!
  71.  
  72. initializeClassDictionary
  73.     "Initialize the class method dictionary."
  74.  
  75. | classes |
  76. classes :=  Object withAllSubclasses reject: [ : c | c printString first = $ ].
  77. classes do: [ : className |
  78.     PublicMethods
  79.         at: className class put: Set new.
  80.     Transcript nextPutAll: 'Examining methods in ',className printString,'.';cr.
  81.     className class selectors do: [ :selectorName |
  82.         (((ReadStream on: (className sourceCodeAt: selectorName)) upTo: $";
  83.             nextWord ) = 'Private')
  84.                 ifFalse: [
  85.                     (PublicMethods at: className class) add: selectorName] ] ]!
  86.  
  87. initializeInstanceDictionary
  88.     "Initialize the instance method dictionary."
  89.  
  90. | classes |
  91. classes :=  Object withAllSubclasses reject: [ : c | c printString first = $ ].
  92. classes do: [ : className |
  93.     PublicMethods
  94.         at: className put: Set new.
  95.     Transcript nextPutAll: 'Examining methods in ',className printString,'.';cr.
  96.     className selectors do: [ :selectorName |
  97.         (((ReadStream on: (className sourceCodeAt: selectorName)) upTo: $";
  98.             nextWord ) = 'Private')
  99.                 ifFalse: [
  100.                     (PublicMethods at: className) add: selectorName] ] ]! !
  101.  
  102.  
  103.  
  104. !PublicBrowser methods !
  105.  
  106. label
  107.         "Private - Answer the window label."
  108.     ^'Public Method Browser'!
  109.  
  110. selectors: selectorPane
  111.         "Private - Set the sorted list of public method
  112.          selectors for the selected class and type
  113.          (class or instance)."
  114.     | methods |
  115.     selectedClass isNil
  116.         ifTrue: [^selectorPane contents: Array new].
  117.     instanceSelectedLast
  118.         ifTrue: [
  119.             selectedInstVar isNil
  120.                 ifTrue: [^selectorPane contents: (PublicMethods at: selectedClass ) asSortedCollection]
  121.                 ifFalse: [
  122.                     methods := assigned
  123.                         ifTrue: [
  124.                             used
  125.                                 ifTrue: [selectedClass allMethodsReferencingInstVar: selectedInstVar]
  126.                                 ifFalse: [selectedClass allMethodsAssigningInstVar: selectedInstVar]]
  127.                         ifFalse: [
  128.                             used
  129.                                 ifTrue: [selectedClass allMethodsUsingInstVar: selectedInstVar]
  130.                                 ifFalse: [^selectorPane contents: selectedClass selectors asSortedCollection]].
  131.                     methods := methods select: [:m | (PublicMethods at: selectedClass)
  132.                         includes: m selector].
  133.                    ^selectorPane contents: (methods collect: [:m | m selector]) asSortedCollection]]
  134.         ifFalse: [
  135.             ^selectorPane contents: (PublicMethods at: selectedClass class) asSortedCollection] ! !
  136.  
  137.  
  138.  
  139. !Behavior methods !
  140.  
  141. removeSelector: aSymbol
  142.         "Remove the method named aSymbol from
  143.          the methods defined in the receiver.
  144.  
  145.         Note:  This version has been modified so that the selectors
  146.         for public methods are removed from the PublicMethods global
  147.         dictionary."
  148.  
  149.     self methodDictionary
  150.         removeKey: aSymbol
  151.         ifAbsent: [].     
  152.  
  153.     "The following code is for the Public Method Browser."
  154.     (PublicMethods at: self ifAbsent: [^nil])
  155.         remove: aSymbol
  156.         ifAbsent: []! 
  157.  
  158.  
  159. compile: codeString notifying: requestor
  160.         "Compile the Smalltalk method contained in codeString.
  161.          The class to use for resolving variables is the receiver.
  162.          If there are no errors, add the method to the recevier
  163.          messageDictionary and answer the Association with the
  164.          message selector as the key and the compiled method
  165.          as the value.  If there is an error the requestor is sent
  166.          a message by the compiler identitfying the error and
  167.          this method answers nil.
  168.  
  169.         Note:  This method has been modified so that compiled
  170.         methods are added to the Public Method Dictionary
  171.         if appropriate." 
  172.  
  173.     | answer |
  174.     answer := Compiler
  175.         compile: codeString
  176.         in: self
  177.         notifying: requestor
  178.         ifFail: [^nil].
  179.   "Check for method defined from a browser if new method
  180.     for class redefines method in superclass.  If so, ask
  181.     for confirmation before installing method."
  182.     ((requestor isWindow)
  183.             and: [(self includesSelector: answer key) not])
  184.         ifTrue: [ "from browser and new method"
  185.             (self canUnderstand: answer key)
  186.                 ifTrue: [ "a superclass defines it"
  187.                     (MessageBox
  188.                         titled: 'Caution'
  189.                         withText:  'You are redefining a superclass method.'
  190.                         style: MbOkcancel)
  191.                             = Idok ifFalse: [^nil]]].
  192.     self addSelector: answer key withMethod: answer value.  
  193.  
  194.     "The following code is for the Public Method Browser."
  195.         (((ReadStream on: codeString) upTo: $";
  196.             nextWord ) = 'Private')
  197.                 ifFalse: [
  198.                     (PublicMethods at: self ifAbsent: [^answer]) add: answer key].
  199.  
  200.     ^answer! !
  201.  
  202.  
  203. !ClassHierarchyBrowser methods !
  204.  
  205. addSubClass
  206.         "Private - Add a subclass to the selected
  207.          class.  If a class is selected, prompt the
  208.          user for a new class name and add it as a
  209.          subclass to the selected class."
  210.     | newSubclassDialog newName subclassType |
  211.     selectedClass isNil ifTrue: [selectedClass := Object].
  212.     newSubclassDialog := NewSubclassDialog open: selectedClass.
  213.     newName := newSubclassDialog subclassName.
  214.     (newName isNil or: [newName isEmpty])
  215.         ifTrue: [^nil].
  216.     (newName at: 1) isUpperCase
  217.         ifFalse: [
  218.             newName at: 1
  219.             put: (newName at: 1) asUpperCase].
  220.     newName := newName asSymbol.
  221.     (Smalltalk includesKey: newName)
  222.         ifTrue: [^self error: newName, ' already exists'].
  223.     subclassType := newSubclassDialog isFixed
  224.         ifTrue: [#pointer]
  225.         ifFalse: [newSubclassDialog isPointer
  226.             ifTrue: [#indexed]
  227.             ifFalse: [#byte]].
  228.     (subclassType == #pointer and: [selectedClass isVariable])
  229.         ifTrue: [
  230.             (MessageBox confirm: 'Indexed pointer subclass assumed')
  231.                 ifFalse: [^self]].
  232.     subclassType == #pointer
  233.         ifTrue: [
  234.             ((selectedClass subclass: newName
  235.                 instanceVariableNames: ''
  236.                 classVariableNames: ''
  237.                 poolDictionaries: '')
  238.                     isKindOf: Class)
  239.                         ifFalse: [^self]].
  240.     subclassType == #indexed
  241.         ifTrue: [
  242.             ((selectedClass variableSubclass: newName
  243.                 instanceVariableNames: ''
  244.                 classVariableNames: ''
  245.                 poolDictionaries: '')
  246.                     isKindOf: Class)
  247.                         ifFalse: [^self]].
  248.     subclassType == #byte
  249.         ifTrue: [
  250.             ((selectedClass variableByteSubclass: newName
  251.                 classVariableNames: ''
  252.                 poolDictionaries: '')
  253.                     isKindOf: Class)
  254.                         ifFalse: [^self]].
  255.     subclassType isNil ifTrue: [^self].
  256.     selectedClass := Smalltalk at: newName asSymbol.
  257.     CursorManager execute change.
  258.     selectedMethod := nil.
  259.     methodSelectedLast := false.
  260.     self update: originalClasses.
  261.     self
  262.         changed: #hierarchy:
  263.         with: #restoreSelected:
  264.         with: ((String new:
  265.             (Smalltalk at: newName asSymbol)
  266.                 allSuperclasses size * 2)
  267.                     atAllPut: $ ), newName.
  268.  
  269.     "The following is for the Public Browser."
  270.     PublicMethods
  271.         at: selectedClass put: Set new;
  272.         at: selectedClass class put: Set new.
  273.  
  274.     self
  275.         changed: #selectors: ;
  276.         changed: #instanceVars: ;
  277.         changed: #text: ! 
  278.  
  279. removeSubClass
  280.         "Private - Delete the selected class."
  281.     | newName subclassType answer |
  282.     selectedClass isNil
  283.         ifTrue: [^nil].
  284.     (MessageBox confirm: 'Delete Class "', selectedClass name, '"?')
  285.         ifFalse: [^nil].
  286.     CursorManager execute change.
  287.     selectedClass removeFromSystem.
  288.     selectedMethod := nil.
  289.     methodSelectedLast := false.
  290.     self update: originalClasses.
  291.     self changed: #hierarchy:
  292.         with: #restore.
  293.  
  294.     "The following is for the Public Browser."
  295.     PublicMethods
  296.         removeKey: selectedClass;
  297.         removeKey: selectedClass class.
  298.  
  299.     selectedClass := nil.
  300.  
  301.     self
  302.         changed: #selectors: ;
  303.         changed: #instanceVars: ;
  304.         changed: #text: ! !
  305.